home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / share / cvs / contrib / rcslock < prev    next >
Text File  |  2005-10-16  |  8KB  |  254 lines
  1. #! /usr/bin/perl -T
  2. # -*-Perl-*-
  3.  
  4. ###############################################################################
  5. ###############################################################################
  6. ###############################################################################
  7. #
  8. # THIS SCRIPT IS PROBABLY BROKEN.  REMOVING THE -T SWITCH ON THE #! LINE ABOVE
  9. # WOULD FIX IT, BUT THIS IS INSECURE.  WE RECOMMEND FIXING THE ERRORS WHICH THE
  10. # -T SWITCH WILL CAUSE PERL TO REPORT BEFORE RUNNING THIS SCRIPT FROM A CVS
  11. # SERVER TRIGGER.  PLEASE SEND PATCHES CONTAINING THE CHANGES YOU FIND
  12. # NECESSARY TO RUN THIS SCRIPT WITH THE TAINT-CHECKING ENABLED BACK TO THE
  13. # <bug-cvs@gnu.org> MAILING LIST.
  14. #
  15. # For more on general Perl security and taint-checking, please try running the
  16. # `perldoc perlsec' command.
  17. #
  18. ###############################################################################
  19. ###############################################################################
  20. ###############################################################################
  21.  
  22. # Author: John Rouillard (rouilj@cs.umb.edu)
  23. # Supported: Yeah right. (Well what do you expect for 2 hours work?)
  24. # Blame-to: rouilj@cs.umb.edu
  25. # Complaints to: Anybody except Brian Berliner, he's blameless for
  26. #         this script.
  27. # Acknowlegements: The base code for this script has been acquired
  28. #            from the log.pl script.
  29.  
  30. # rcslock.pl - A program to prevent commits when a file to be ckecked
  31. #            in is locked in the repository.
  32.  
  33. # There are times when you need exclusive access to a file.  This
  34. # often occurs when binaries are checked into the repository, since
  35. # cvs's (actually rcs's) text based merging mechanism won't work. This
  36. # script allows you to use the rcs lock mechanism (rcs -l) to make
  37. # sure that no changes to a repository are able to be committed if
  38. # those changes would result in a locked file being changed.
  39.  
  40. # WARNING:
  41. # This script will work only if locking is set to strict.
  42. #
  43.  
  44. # Setup:
  45. # Add the following line to the commitinfo file:
  46.  
  47. #         ALL /local/location/for/script/lockcheck [options]
  48.  
  49. # Where ALL is replaced by any suitable regular expression.
  50. # Options are -v for verbose info, or -d for debugging info.
  51. # The %s will provide the repository directory name and the names of
  52. # all changed files.  
  53.  
  54. # Use:
  55. # When a developer needs exclusive access to a version of a file, s/he
  56. # should use "rcs -l" in the repository tree to lock the version they
  57. # are working on.  CVS will automagically release the lock when the
  58. # commit is performed.
  59.  
  60. # Method:
  61. # An "rlog -h" is exec'ed to give info on all about to be
  62. # committed files.  This (header) information is parsed to determine
  63. # if any locks are outstanding and what versions of the file are
  64. # locked.  This filename, version number info is used to index an
  65. # associative array.  All of the files to be committed are checked to
  66. # see if any locks are outstanding.  If locks are outstanding, the
  67. # version number of the current file (taken from the CVS/Entries
  68. # subdirectory) is used in the key to determine if that version is
  69. # locked. If the file being checked in is locked by the person doing
  70. # the checkin, the commit is allowed, but if the lock is held on that
  71. # version of a file by another person, the commit is not allowed.
  72.  
  73. $ext = ",v";  # The extension on your rcs files.
  74.  
  75. $\="\n";  # I hate having to put \n's at the end of my print statements
  76. $,=' ';   # Spaces should occur between arguments to print when printed
  77.  
  78. # turn off setgid
  79. #
  80. $) = $(;
  81.  
  82. #
  83. # parse command line arguments
  84. #
  85. require 'getopts.pl';
  86.  
  87. &Getopts("vd"); # verbose or debugging
  88.  
  89. # Verbose is useful when debugging
  90. $opt_v = $opt_d if defined $opt_d;
  91.  
  92. # $files[0] is really the name of the subdirectory.
  93. # @files = split(/ /,$ARGV[0]);
  94. @files = @ARGV[0..$#ARGV];
  95. $cvsroot = $ENV{'CVSROOT'};
  96.  
  97. #
  98. # get login name
  99. #
  100. $login = getlogin || (getpwuid($<))[0] || "nobody";
  101.  
  102. #
  103. # save the current directory since we have to return here to parse the
  104. # CVS/Entries file if a lock is found.
  105. #
  106. $pwd = `/bin/pwd`;
  107. chop $pwd;
  108.  
  109. print "Starting directory is $pwd" if defined $opt_d ;
  110.  
  111. #
  112. # cd to the repository directory and check on the files.
  113. #
  114. print "Checking directory ", $files[0] if defined $opt_v ;
  115.  
  116. if ( $files[0] =~ /^\// )
  117. {
  118.    print "Directory path is $files[0]" if defined $opt_d ;
  119.    chdir $files[0] || die "Can't change to repository directory $files[0]" ;
  120. }
  121. else
  122. {
  123.    print "Directory path is $cvsroot/$files[0]" if defined $opt_d ;
  124.    chdir ($cvsroot . "/" . $files[0]) || 
  125.          die "Can't change to repository directory $files[0] in $cvsroot" ;
  126. }
  127.  
  128.  
  129. # Open the rlog process and apss all of the file names to that one
  130. # process to cut down on exec overhead.  This may backfire if there
  131. # are too many files for the system buffer to handle, but if there are
  132. # that many files, chances are that the cvs repository is not set up
  133. # cleanly.
  134.  
  135. print "opening rlog -h @files[1..$#files] |" if defined $opt_d;
  136.  
  137. open( RLOG, "rlog -h @files[1..$#files] |") || die "Can't run rlog command" ;
  138.  
  139. # Create the locks associative array.  The elements in the array are
  140. # of two types:
  141. #
  142. #  The name of the RCS file with a value of the total number of locks found
  143. #            for that file,
  144. # or
  145. #
  146. # The name of the rcs file concatenated with the version number of the lock.
  147. # The value of this element is the name of the locker.
  148.  
  149. # The regular expressions used to split the rcs info may have to be changed.
  150. # The current ones work for rcs 5.6.
  151.  
  152. $lock = 0;
  153.  
  154. while (<RLOG>)
  155. {
  156.     chop;
  157.     next if /^$/; # ditch blank lines
  158.  
  159.     if ( $_ =~ /^RCS file: (.*)$/ )
  160.     {
  161.        $curfile = $1;
  162.        next;
  163.     }
  164.  
  165.     if ( $_ =~ /^locks: strict$/ )
  166.     {
  167.         $lock = 1 ;
  168.       next;
  169.     }
  170.  
  171.     if ( $lock )
  172.     {
  173.       # access list: is the line immediately following the list of locks.
  174.       if ( /^access list:/ )
  175.       { # we are done getting lock info for this file.
  176.         $lock = 0;
  177.       }
  178.       else
  179.       { # We are accumulating lock info.
  180.  
  181.         # increment the lock count
  182.         $locks{$curfile}++;
  183.         # save the info on the version that is locked. $2 is the
  184.             # version number $1 is the name of the locker.
  185.         $locks{"$curfile" . "$2"} = $1 
  186.                 if /[     ]*([a-zA-Z._]*): ([0-9.]*)$/;
  187.  
  188.         print "lock by $1 found on $curfile version $2" if defined $opt_d;
  189.  
  190.       }
  191.     }
  192. }
  193.  
  194. # Lets go back to the starting directory and see if any locked files
  195. # are ones we are interested in.
  196.  
  197. chdir $pwd;
  198.  
  199. # fo all of the file names (remember $files[0] is the directory name
  200. foreach $i (@files[1..$#files])
  201. {
  202.   if ( defined $locks{$i . $ext} )
  203.   { # well the file has at least one lock outstanding
  204.  
  205.      # find the base version number of our file
  206.      &parse_cvs_entry($i,*entry);
  207.  
  208.      # is our version of this file locked?
  209.      if ( defined $locks{$i . $ext . $entry{"version"}} )
  210.      { # if so, it is by us?
  211.     if ( $login ne ($by = $locks{$i . $ext . $entry{"version"}}) )
  212.     {# crud somebody else has it locked.
  213.        $outstanding_lock++ ;
  214.        print "$by has file $i locked for version " , $entry{"version"};
  215.     }
  216.     else
  217.     { # yeah I have it locked.
  218.        print "You have a lock on file $i for version " , $entry{"version"}
  219.         if defined $opt_v;
  220.     }
  221.      }
  222.   }
  223. }
  224.  
  225. exit $outstanding_lock;
  226.  
  227.  
  228. ### End of main program
  229.  
  230. sub parse_cvs_entry
  231. { # a very simple minded hack at parsing an entries file.
  232. local ( $file, *entry ) = @_;
  233. local ( @pp );
  234.  
  235.  
  236. open(ENTRIES, "< CVS/Entries") || die "Can't open entries file";
  237.  
  238. while (<ENTRIES>)
  239.  {
  240.   if ( $_  =~ /^\/$file\// )
  241.   {
  242.     @pp = split('/');
  243.  
  244.     $entry{"name"} = $pp[1];
  245.     $entry{"version"} = $pp[2];
  246.     $entry{"dates"} = $pp[3];
  247.     $entry{"name"} = $pp[4];
  248.     $entry{"name"} = $pp[5];
  249.     $entry{"sticky"} = $pp[6];
  250.     return;
  251.   }
  252.  }
  253. }
  254.